home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.44 / puritymag / rubriken.h < prev    next >
Text File  |  1995-02-26  |  4KB  |  186 lines
  1. {$if not def PURITY_MAG_RUBRIKEN_H}
  2.  
  3. CONST
  4.   PURITY_MAG_RUBRIKEN_H = "P_M_R_H";
  5.   ZURÜCK = "Zurück zum Hauptmenü...";
  6.  
  7. PROCEDURE Setter(VAR txt:feld; VAR anz:INTEGER; tit:STRING);
  8. VAR
  9.   ok : WORD;
  10.   lastg : p_Gadget;
  11.   t : ARRAY[1..2] OF TagItem;
  12.   it : p_IntuiText;
  13.   xx : STRING;
  14. BEGIN
  15.   FOR i := 1 TO anz DO rubigad[i] := NIL;
  16.   gl1 := NIL;
  17.   gl1 := CreateContext(^gl1);
  18.   lastg := gl1;
  19.   UniPrint(wp,tit,3,2,0,1,TRUE,TRUE,^tattr);
  20.   j:=16;
  21.   x:=1;
  22.   IF anz <= 15 THEN x := (wp^.Width - 200) DIV 2;
  23.   FOR I := 1 TO anz DO
  24.   BEGIN
  25.     IF Length(txt[i]^)>23 THEN txt[i]^:=Copy(txt[i]^,1,23);
  26.     IF txt[i]^[1]<>"@" THEN
  27.     BEGIN
  28.       t[1] := TagItem(GT_Underscore,LONG("_"));
  29.       t[2].ti_Tag := TAG_DONE;
  30.       ng := NewGadget(x,j,200,14,
  31.                       txt[i],^tattr,
  32.                       i+7,PLACETEXT_IN,
  33.                       vi,NIL);
  34.       xx := "_"+ZURÜCK;
  35.       IF ng.ng_GadgetText = "%ZURÜCK" THEN ng.ng_GadgetText := ^xx;
  36.       rubigad[i] := CreateGadgetA(BUTTON_KIND,lastg,^ng,^t);
  37.       IF ng.ng_GadgetText = xx THEN zurückgad := rubigad[i];
  38.       lastg := rubigad[i];
  39.     END ELSE
  40.     UniPrint(wp,Copy(txt[i]^,2,Length(txt[i]^)),3,2,x+((200-((Length(txt[i]^)-1)*8)) div 2),j+3,TRUE,FALSE,^tattr);
  41.     IF j+15>maxy THEN
  42.     BEGIN
  43.       x:=x+200;
  44.       j:=16;
  45.     END ELSE j:=j+15;
  46.   END;
  47.   FOR i := 1 TO anz DO
  48.   BEGIN
  49.     IF rubigad[i]<>NIL THEN ok := AddGadget(wp,rubigad[i],0);
  50.   END;
  51.   RefreshGadgets(wp^.FirstGadget,wp,NIL);
  52. END;
  53.  
  54. PROCEDURE execu(bef : String; VAR txt:feld; VAR anz:INTEGER; tit:STRING);
  55. VAR
  56.   ok : BOOLEAN;
  57.   l : LONG;
  58. BEGIN
  59.   IF gl1<>NIL THEN
  60.   BEGIN
  61.     l := RemoveGList(wp,wp^.FirstGadget,-1);
  62.     FreeGadgets(gl1);
  63.   END;
  64.   gl1 := NIL;
  65.   CloseWindow(wp);
  66.   ok := CloseScreen(sp);
  67.   wp:=NIL;
  68.   sp:=NIL;
  69.   { Programm starten ! }
  70.   err:=Execute(bef,0,fh);
  71.   ausf:="Ausführung hat nicht geklappt!";
  72.   If err=DOSFALSE Then
  73.   Begin
  74.     dd:=DosWrite(fh,^ausf,30);
  75.   End;
  76.   Delay(50);
  77.   OpenStuff;
  78.   Setter(txt,anz,tit);
  79. END;
  80.  
  81. PROCEDURE SetRubi(VAR txt,bef:feld; VAR anz:INTEGER; tit:STRING);
  82. VAR
  83.   ok : WORD;
  84.   dummy : BOOLEAN;
  85. BEGIN
  86.   IF gl<>NIL THEN
  87.   BEGIN
  88.     ok := removeGList(wp,wp^.FirstGadget,-1);
  89.     FreeGadgets(gl);
  90.   END;
  91.   gl := NIL;
  92.   Setter(txt,anz,tit);
  93.   dummy := FALSE;
  94.   REPEAT
  95.     msg := p_IntuiMessage(WaitPort(wp^.UserPort));
  96.     msg := GT_GetIMsg(wp^.UserPort);
  97.     class := msg^.Class;
  98.     code := msg^.Code;
  99.     qual := msg^.Qualifier;
  100.     IF class IN [IDCMP_GADGETUP, IDCMP_GADGETDOWN] THEN
  101.     BEGIN
  102.       KlickG := msg^.IAddress;
  103.       GadNum := KlickG^.GadgetID;
  104.     END;
  105.     GT_ReplyIMsg(msg);
  106.     CASE class OF
  107.       IDCMP_RAWKEY :
  108.         CASE code OF
  109.          21: BEGIN
  110.                IF zurückgad<>NIL THEN ButSelecter(wp,zurückgad);
  111.                dummy := TRUE;
  112.              END;
  113.         ELSE END;
  114.       IDCMP_GADGETUP:
  115.         CASE GadNum OF
  116.           8..47: BEGIN
  117.                    IF txt[GadNum-7]^ = "%ZURÜCK" THEN dummy := TRUE
  118.                    ELSE
  119.                    execu(bef[GadNum-7]^,txt,anz,tit);
  120.                  END;
  121.           48   : dummy := TRUE;
  122.         ELSE END;
  123.     ELSE END;
  124.   UNTIL dummy;
  125.   zurückgad := NIL;
  126.   IF gl1<>NIL THEN
  127.   BEGIN
  128.     FreeGadgets(gl1);
  129.     ok := RemoveGList(wp,wp^.FirstGadget,-1);
  130.   END;
  131.   gl1 := NIL;
  132.   Cls;
  133. END;
  134.  
  135. PROCEDURE Forum;
  136. BEGIN
  137.   Cls;
  138.   SetRubi(fortxt,forbef,foranz,forumm);
  139. END;
  140.  
  141. PROCEDURE Newss;
  142. BEGIN
  143.   Cls;
  144.   SetRubi(hspastxt,hspasbef,hspasanz,hsp);
  145. END;
  146.  
  147. PROCEDURE Allgemeines;
  148. BEGIN
  149.   Cls;
  150.   SetRubi(alltxt,allbef,allanz,allge);
  151. END;
  152.  
  153. PROCEDURE pcqq;
  154. BEGIN
  155.   Cls;
  156.   SetRubi(pcqtxt,pcqbef,pcqanz,pccq);
  157. END;
  158.  
  159. PROCEDURE kickk;
  160. BEGIN
  161.   Cls;
  162.   SetRubi(kicktxt,kickbef,kickanz,kikk);
  163. END;
  164.  
  165. PROCEDURE Anleitungen;
  166. BEGIN
  167.   Cls;
  168.   SetRubi(anltxt,anlbef,anlanz,anll);
  169. END;
  170.  
  171. PROCEDURE liesmz;
  172. BEGIN
  173.   ScreenToBack(sp);
  174.   err:=Execute(lies_mich_zuerst,0,fh);
  175.   If err=DOSFALSE Then
  176.   BEGIN
  177.     dd:=DosWrite(fh,^ausf,30);
  178.     Delay(50);
  179.   END;
  180.   ScreenToFront(sp);
  181. END;
  182.  
  183. {$endif}
  184.  
  185.  
  186.